package Waya::Log;

# $Id$

use warnings;
use strict;
use Carp;
use IO::File;


our $VERSION = '0.1';


use base qw(
    Class::Accessor::Complex
    Class::Accessor::Constructor
);


__PACKAGE__
    ->mk_singleton_constructor(qw(instance))
    ->mk_scalar_accessors(qw(filename max_level))
    ->mk_concat_accessors(qw(output))
    ->mk_boolean_accessors(qw(pid timestamp));


sub init {
    my $self = shift;
    $self->max_level or $self->max_level(1);
    $self->clear_pid;
    $self->set_timestamp;
}


# like get_set, but also generate handle from filename unless defined
sub handle {
    my $self = shift;
    $self = Waya::Log->instance unless ref $self;

    if (@_) {
        $self->{handle} = shift;
    } else {
        if ($self->filename) {
            $self->{handle} ||=
                IO::File->new(sprintf(">>%s", $self->filename)) or
                die sprintf("can't append to %s: %s\n", $self->filename, $!);
        } else {
            $self->{handle} ||= IO::File->new(">&STDERR") or
                die "can't open STDERR: $!\n";
        }
        $self->{handle}->autoflush(1);
        return $self->{handle};
    }
}


# called like printf
sub log {
    my ($self, $level, $format, @args) = @_;
    $format = "$format";

    # in case someone passes us an object that needs to be stringified so we
    # can compare it with 'ne' further down (e.g., an exception object).

    $self = Waya::Log->instance unless ref $self;
    return unless defined $format and $format ne '';
    return if $level > $self->max_level;

    # make sure there's exactly one newline at the end
    1 while chomp $format;
    $format .= "\n";

    $format = sprintf "(%05d) %s", $$, $format if $self->pid;
    $format = sprintf "%s %s", $self->now, $format if $self->timestamp;
    my $msg = sprintf $format => @args;

    $self->handle->print($msg) or die "can't print to log handle: $!\n";
    $self->output($msg);
}


sub now {
    sprintf "%04d%02d%02d.%02d%02d%02d",
        sub { $_[5]+1900, $_[4]+1, reverse @_[0..3] }->(localtime);
}


sub info {
    my $self = shift;
    $self->log(1, @_);
}


sub debug {
    my $self = shift;
    $self->log(2, @_);
}


sub deep_debug {
    my $self = shift;
    $self->log(3, @_);
}


sub close {
    my $self = shift;
    $self->handle->close or die "can't close log handle: $!\n";
}


# log a final message, close the log and croak.
sub fatal {
    my ($self, $format, @args) = @_;
    my $message = sprintf($format, @args);
    $self->info($message);
    croak($message);
}


1;
